'' Replace both the Public Sub InvisibilityOn() and Public Sub InvisibilityOff() subroutines with the code below

Public Sub InvisibilityOn()

    Dim answer As Integer
    Dim i As Long

    ' Prompt the user before running the macro
    answer = MsgBox("This action will permanently delete text that is not in the highlight, tag, or cite style. Are you sure?", vbYesNo, "Confirmation")

    If answer = vbNo Then
        Exit Sub
    End If

    ' Delete all text with the color RGB(85, 85, 85)
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Text = ""
        .Font.Color = RGB(85, 85, 85)
        .Replacement.ClearFormatting
        .Replacement.Text = ""
        .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
    End With

    ' Move the cursor to the beginning of the document
    Selection.HomeKey Unit:=wdStory

    ' Replace all paragraph marks with highlighted and bolded paragraph marks
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "^p"
        .Replacement.Text = "^p"
        .Replacement.Style = "Underline"
        .Replacement.Highlight = True
        .Replacement.Font.Bold = True
        .MatchWildcards = False
        .Execute Replace:=wdReplaceAll
    End With

    ' Delete non-highlighted "Normal" text
    With Selection.Find
        .ClearFormatting
        .Style = "Normal"
        .Highlight = False
        .Font.Bold = False
        .Replacement.ClearFormatting
        .Text = ""
        .Replacement.Text = " "
        .Execute Replace:=wdReplaceAll
    End With

    ' Delete non-highlighted "Underline" text
    With Selection.Find
        .ClearFormatting
        .Style = "Underline"
        .Highlight = False
        .Replacement.ClearFormatting
        .Text = ""
        .Replacement.Text = " "
        .Execute Replace:=wdReplaceAll
    End With

    ' Delete non-highlighted "Undertag" text
    With Selection.Find
        .ClearFormatting
        .Style = "Undertag"
        .Highlight = False
        .Replacement.ClearFormatting
        .Text = ""
        .Replacement.Text = " "
        .Execute Replace:=wdReplaceAll
    End With

    ' Delete non-highlighted "Emphasis" text
    With Selection.Find
        .ClearFormatting
        .Style = "Emphasis"
        .Highlight = False
        .Replacement.ClearFormatting
        .Text = ""
        .Replacement.Text = " "
        .Execute Replace:=wdReplaceAll
    End With

    ' Remove extra spaces between paragraph marks
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "^p ^p"
        .Replacement.Text = ""
        .Replacement.Highlight = False
        .Execute Replace:=wdReplaceAll
    End With

    ' Remove consecutive spaces in non-highlighted text
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "( ){2,}"
        .Highlight = False
        .MatchWildcards = True
        .Replacement.Text = " "
        .Execute Replace:=wdReplaceAll
    End With

    ' Remove spaces at the beginning of paragraphs
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "^p "
        .Replacement.Text = "^p"
        .MatchWildcards = False
        .Execute Replace:=wdReplaceAll
    End With

    ' Remove consecutive paragraph marks in non-highlighted text
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "^13{1,}"
        .Replacement.Text = "^p"
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With

    ' Prompt the user for condensing card text
    answer = MsgBox("Would you like to condense card text? This may take up to a minute and will make the zap more difficult to undo.", vbYesNo, "Confirmation")

    If answer = vbYes Then
        ' Remove line breaks surrounded on both sides by highlighted text
        Dim para As Paragraph
        Dim rng As Range
        Dim highlighted As Boolean

        For Each para In ActiveDocument.Paragraphs
            Set rng = para.Range
            rng.MoveEnd wdCharacter, -1 ' Ignore the paragraph mark

            ' Check if the current paragraph contains highlighted text
            highlighted = False
            For i = 1 To rng.Characters.count
                If rng.Characters(i).HighlightColorIndex <> wdNoHighlight Then
                    highlighted = True
                    Exit For
                End If
            Next i

            ' Check if the next paragraph exists and contains highlighted text
            Dim nextHighlighted As Boolean
            nextHighlighted = False
            If Not para.Next Is Nothing Then
                For i = 1 To para.Next.Range.Characters.count - 1 ' Ignore the paragraph mark
                    If para.Next.Range.Characters(i).HighlightColorIndex <> wdNoHighlight Then
                        nextHighlighted = True
                        Exit For
                    End If
                Next i
            End If

            ' If both paragraphs contain highlighted text, join them
            If highlighted And nextHighlighted Then
                rng.InsertAfter " " ' Insert a space after the current paragraph
                para.Range.Characters.Last.Delete ' Delete the paragraph mark
            End If
        Next para
    End If

    ' Clean up and suppress errors
    Selection.Find.ClearFormatting
    Selection.Find.MatchWildcards = False
    Selection.Find.Replacement.ClearFormatting
    ActiveDocument.ShowGrammaticalErrors = False
    ActiveDocument.ShowSpellingErrors = False

End Sub

Public Sub InvisibilityOff()
    ' Set the whole doc visible
    ActiveDocument.Range.Font.Hidden = False
    
    ' Turn error checking back on but set it to checked
    ActiveDocument.ShowGrammaticalErrors = False
    ActiveDocument.ShowSpellingErrors = False
    ActiveDocument.GrammarChecked = True
    ActiveDocument.SpellingChecked = True
    ActiveDocument.ShowGrammaticalErrors = True
    ActiveDocument.ShowSpellingErrors = True
End Sub